home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD ROM Paradise Collection 4
/
CD ROM Paradise Collection 4 1995 Nov.iso
/
program
/
intrfc70.zip
/
DUMP.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-03-16
|
3KB
|
161 lines
unit dump;
{$I SWITCHES.INC}
{ Various routines to dump memory to system.output }
interface
procedure dumpbytes(var loc;start,num:word);
procedure dumpwords(var loc;start,num:word);
function decword(w:word):string;
function hexbyte(b:byte):string;
function hexword(w:word):string;
function hexwordblank(w:word):string;
function hexwordasm(w:word):string;
implementation
uses
util;
function decword(w:word):string;
var S:string;
begin
Str(w,S);
decword:=S;
end;
function hexbyte(b:byte):string;
const
symbol : array[0..$f] of char = ('0','1','2','3','4','5','6','7',
'8','9','A','B','C','D','E','F');
begin
hexbyte := symbol[b shr 4] + symbol[b and $f];
end;
function hexword(w:word):string;
begin
hexword := hexbyte(hi(w))+hexbyte(lo(w));
end;
function hexwordblank(w:word):string;
var
i : byte;
h : string;
begin
h := hexword(w);
for i:=1 to length(h)-1 do
begin
if h[i] <> '0' then
begin
hexwordblank := h;
exit;
end;
h[i] := ' ';
end;
hexwordblank := h;
end;
function hexwordasm(w:word):string;
var
i : byte;
b : boolean;
h, h1 : string;
begin
h := hexword(w);
b:=false;
h1[0]:=#0;
for i := 1 to length(h) do
if b or (h[i]<>'0') then
begin
if not b and (h[i] in ['A'..'F']) then
begin
h1[1]:='0';
Inc(h1[0]);
end;
b:=true;
Inc(h1[0]);
h1[Ord(h1[0])]:=h[i];
end;
Inc(h1[0]);
h1[Ord(h1[0])]:='h';
hexwordasm:=h1;
end;
function legal(b:byte):char;
begin
if b<32 then
legal := '.'
else
legal := char(b);
end;
procedure dumpbytes(var loc;start,num:word);
var
bytes:array[0..65520] of byte absolute loc;
i,j:word;
procedure dumpascii(last:word);
var
j : word;
begin
for j:=0 to last do
begin
write(legal(bytes[i+start-$F+j]));
end;
end;
begin
if num = 0 then
exit;
for i:=0 to num-1 do
begin
case i mod 16 of
0: begin
writeln;
write(hexword(i+start),':');
end;
8: write(' ');
end;
write(hexbyte(bytes[i+start]):3);
if i mod 16 = $F then
begin
write(' ');
dumpascii($F);
end;
end;
if (num-1) mod 16 < $F then
begin
for j := num mod 16 to $f do
begin
write(' ');
if j = 8 then
write(' ');
end;
write(' ');
i := 16*((num-1) div 16) + $F;
dumpascii((num-1) mod 16);
end;
writeln;
end;
procedure dumpwords(var loc;start,num:word);
var
words:array[0..32760] of word absolute loc;
i:word;
begin
if num = 0 then
exit;
repeat
write(hexword(start):4);
for i:=1 to minw(15,num) do
write(hexword(start+i):5);
writeln;
write(hexword(words[start]));
for i:=1 to minw(15,num) do
write(hexword(words[start+i]):5);
writeln;
inc(start,16);
dec(num,16);
until num > 65535 - 16;
end;
end.